#|_______________________________________________________________
 |
 | views001.lsp  -  ViSta Plots & Views System:
 |
 | Contains the VIEW function and the following spreadplots
 | using it and the new Plot functions
 |
 |    CROSSSTABS-VIEW
 |    MIXED-BIVARIATE-VIEW
 |    NUMERIC-BIVARIATE-VIEW
 |    CATEGORY-BIVARIATE-VIEW
 |    BOXPLOT VIEW
 |    VIEW-EVERY-PLOT
 | 
 | Also contains RELATIONAL VIEW a spreadPplot for 
 | matrix data (using the old graphics system)
 |  1) Double center if distances (zero diagonal, range=0 to inf)
 |  2) Obtain Eigen Solution data=evecs*evals*evecsT
 |  3) Calculate scores=evecs*sqrt(evals)
 |  4) Do multivariate spreadplot of scores
 |
 |________________________________________________________________
 |#


#|________________________________
 |
 | VIEW FUNCTION
 |________________________________
 |#

(defun view 
  (plot-cell-code-lol 
         &key 
         statistical-object 
         rel-widths 
         rel-heights 
         span-right 
         span-down
         (menu-title "SpreadPlot") show 
         (local-links nil) 
         (title)
         (data-object $) 
         (container nil) 
         (style 1)
         (linked t)
         (content-only nil))
         
"Args: plot-functions
       &KEY statistical-object (menu-title \"SpreadPlot\") show 
            (local-links t) (title title)
            rel-widths rel-heights span-right span-down
            (data-object $) (container nil) (style 1)
PLOT-FUNCTIONS is a list of lists, where each element is either a plot function or a list of plot functions, where plot functions are functions in the set of new plot functions"
  (please-wait (format nil "View Creator:  Initializing") :close t)
  (if container
      (enable-container (eval container))
      (setf container (send data-object :create-spreadplot-container style)))
  (let* ((sizes (list (length plot-cell-code-lol) 
                      (length (first plot-cell-code-lol))))
         (num-plotcells (apply #'* sizes))
         (plot-cell-code-matrix (make-array sizes :initial-contents plot-cell-code-lol))
         (plot-cell-code-list 
          (coerce (make-array num-plotcells :displaced-to plot-cell-code-matrix) 'list))
         (rel-widths (if rel-widths rel-widths (repeat 1 (second sizes))))
         (rel-heights (if rel-heights rel-heights (repeat 1 (first sizes))))
         (span-down (if span-down span-down 
                                  (repeat (repeat 1 (second sizes)) (first sizes))))
         (span-right (if span-right span-right 
                                  (repeat (repeat 1 (second sizes)) (first sizes))))
         (aspect-ratio (/ (- (first (effective-screen-size)) 8)
                          (- (second (effective-screen-size)) 42)))
         (wild-card-value (- (* aspect-ratio (sum rel-heights)) (sum rel-widths)))
         (width-wild-card-loc (which (= 0 rel-widths)))
         (height-wild-card-loc (which (= 0 rel-heights)))
         (i 0)
         (n (length plot-cell-code-list))
         (view container)
         (data) (args)
         (result)
         (plot-symbol)
         (plot-object-list)
         (splot))
    (cond
      ((> (length (remove nil (combine width-wild-card-loc height-wild-card-loc))) 1)
       (error "cannot have more than one wildcard height and width"))
      ((not (not width-wild-card-loc))
       (setf (select rel-widths width-wild-card-loc) wild-card-value))
      ((not (not height-wild-card-loc))
       (setf (select rel-heights height-wild-card-loc) wild-card-value)))
    (dolist (plot-cell-code plot-cell-code-list)
            (setf data (second plot-cell-code))
	    (setf args (rest (rest plot-cell-code)))
            (setf plot-symbol (first plot-cell-code))
            (setf i (1+ i))
            (please-wait (format nil "View - Creating Plot ~d of ~d: ~a"
                                i n (string-capitalize (format nil "~a" plot-cell-code))))
            (setf result 
                  (case plot-symbol
                    (hollow-histogram    
                        (apply #'hollow-histogram (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (dynamic-histogram    
                        (apply #'dynamic-histogram (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (linkable-histogram    
                        (apply #'linkable-histogram (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (distribution-plot 
                        (apply #'distribution-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (cumulative-plot   
                        (apply #'cumulative-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (comparison-plot   
                        (apply #'comparison-plot (eval data) 
                               :in view :content-only content-only args))
                    (dot-plot          
                        (apply #'dot-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (scatter-plot      
                        (apply #'scatter-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (scatter-matrix    
                        (apply #'scatter-matrix    (eval data) 
                               :in view :linked linked  :content-only content-only args))
                    (spinning-points     
                        (apply #'spinning-points   (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (orbiting-points     
                        (apply #'orbiting-points   (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (line-plot         
                        (apply #'line-plot         (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (box-plot          
                        (apply #'box-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (diamond-plot      
                        (apply #'diamond-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (grouped-box-plot  
                        (apply #'grouped-box-plot  (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (parallel-coordinates    
                        (apply #'parallel-coordinates (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (mosaic-plot       
                        (apply #'mosaic-plot (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (bar-graph         
                        (apply #'bar-graph  (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (stacked-bar-graph         
                        (apply #'stacked-bar-graph  (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (labels-list       
                        (apply #'labels-list  (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (variables-list    
                        (apply #'variables-list (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (categories-list   
                        (apply #'categories-list (eval data) 
                               :in view :linked linked :content-only content-only args))
                    (data-browser
                        (apply #'data-browser  (eval data) :in view args))
                    (nil               nil)
                    (t                 (error-message "unknown plot function"))))
            (setf plot-object-list (append plot-object-list (list result))))

    (please-wait (format nil "View - Creating Layout"))
    (setf splot (spreadplot (matrix sizes plot-object-list)
                            :rel-widths rel-widths
                            :rel-heights rel-heights
                            :span-down (matrix sizes (combine span-down))
                            :span-right (matrix sizes (combine span-right))
                            :container view
                            :title (if title title
                                       (format nil "Unnamed View [~a]" (send @ :name)))
                            :statistical-object statistical-object
                            :local-links local-links
                            ))
    (let ((plot))
      (dotimes (i (length plot-object-list)) 
               (setf plot (select plot-object-list i))
               (when plot (send (select plot-object-list i) :showing-labels nil))))
    (send *please-wait* :remove)
    (send splot :show-spreadplot)
    (disable-container)
    ;(send container :make-close-menu)
    splot
    ))



#|________________________________________________________________
 |
 | MIXED-BIVARIATE-VIEW - matrix of bivariate plots for all pairs of variables
 |________________________________________________________________
 |#



(defun mixed-bivariate-view (&optional (dob $))
  (let* ((variables (mapcar #'(lambda (string) 
                                (symbol-from-string string)) 
                      (send dob :active-variables '(all))))
         (types (send dob :active-types '(all)))
         (plot)
         (splot)
         (plots-list)
         (plots-lol ) 
         (numvar (length variables))    
         (go t)
         )
    (cond
      ((> numvar 9) 
       (error-message "No more than 9 variables may be visualized.")
       (setf go nil))
      ((> numvar 7) 
       (setf go (two-button-dialog (format nil "There are ~d variables.~%Do you wish to visualize this many?" numvar) :first-button "Yes, Please" :second-button "No, Thanks"))))
    (when go
    (dotimes (i numvar)
             (dotimes (j (1+ numvar))
                      (cond
                        ((= j numvar)
                         (if (= i 0)
                             (setf plot `(labels-list))
                             (setf plot nil)))
                        ((= j numvar)
                         (if (= i 0)
                             (setf plot (labels-list))
                             (setf plot nil)))
                        ((= i j)
                         (setf plot (if (equal (select types i) "Numeric")
                                        `(cumulative-plot (list ,(select variables i)))
                                        `(bar-graph  (list ,(select variables i))))))
                        (t
                         (setf plot (cond 
                                      ((and (equal (select types i) "Numeric")     
                                            (equal (select types j) "Numeric")
                                            (> i j))
                                       `(scatter-plot (list ,(select variables i) 
                                                            ,(select variables j))))
                                      ((and (equal (select types i) "Numeric")     
                                            (equal (select types j) "Numeric")
                                            (< i j))
                                       `(comparison-plot (list ,(select variables i) 
                                                               ,(select variables j))))
                                      ((and (equal (select types i) "Category")    
                                            (equal (select types j) "Category")
                                            (< i j))
                                       `(mosaic-plot  (list ,(select variables i) 
                                                            ,(select variables j))))
                                      ((and (equal (select types i) "Category")    
                                            (equal (select types j) "Category")
                                            (> i j))
                                       `(stacked-bar-graph  (list ,(select variables i) 
                                                          ,(select variables j))))
                                      ((and (equal (select types i) "Numeric")     
                                            (equal (select types j) "Category"))
                                       `(grouped-box-plot (list ,(select variables i) 
                                                                ,(select variables j))))
                                      ((and (equal (select types i) "Category")     
                                            (equal (select types j) "Numeric"))
                                       `(grouped-box-plot  (list ,(select variables i) 
                                                                 ,(select variables j))))
                                      ))))
                      (setf plots-list (append plots-list (list plot))))
             (setf plots-lol (append plots-lol (list plots-list)))
             (setf plots-list nil))
    (setf splot (eval `(view ',plots-lol :style 1 :content-only t
                             :span-down ',(list (combine (repeat 1 numvar) numvar)
                                                (repeat (combine (repeat 1 numvar) 0) 
                                                        (1- numvar))))))
    )))

#|________________________________________________________________
 |
 | CROSSTAB-VIEW - spreadplot for crosstabs
 |________________________________________________________________
 |#

(defun crosstabs-view ()
  (view '(((variables-list)  (mosaic-plot)  (grouped-box-plot) (labels-list))
          ((categories-list) (data-browser) nil                nil      ))
        :rel-widths '(.4 1 1 0)
        :span-down  '((1 1 1 2) (1 1 0 0))
        :span-right '((1 1 1 1) (1 2 0 0))
        :style 1 ; 0=seamless 1=borders 7=borders+titles
        :content-only nil
        )
  )

(defun view-every-plot ()
  (view '(((hollow-histogram)     (dynamic-histogram)    (distribution-plot) 
           (cumulative-plot)      (comparison-plot)      (labels-list))
          ((linkable-histogram)   (scatter-plot)         (scatter-matrix)    
           (spinning-points)      (orbiting-points)       nil)
          ((box-plot)             (diamond-plot)         (grouped-box-plot)  
           (parallel-coordinates) (dot-plot)              nil)
          ((mosaic-plot)          (bar-graph)            (line-plot)         
           nil                    nil                    nil))
         
        :rel-widths  '(1 1 1 1 1 0)
        :span-down  '((1 1 1 1 1 4)
                      (1 1 1 1 1 0)
                      (1 1 1 1 1 0)
                      (1 1 1 1 1 0))
        :span-right '((1 1 1 1 1 1)
                      (1 1 1 1 1 0)
                      (1 1 1 1 1 0)
                      (1 1 3 0 0 0))
        :style 1 
        :title (format nil "EveryPlot View [~a]" (send @ :name))
        :content-only t))

(defun boxplot-view (&optional (dob $))
  (let* ((numeric-variables 
          (mapcar #'(lambda (string) 
                      (symbol-from-string string)) 
                  (send dob :active-variables '(numeric))))
         (numeric-variables-list
          (mapcar #'(lambda (string) 
                      (symbol-from-string string)) 
                  (combine "list" (send dob :active-variables '(numeric)))))
         (category-variables 
          (mapcar #'(lambda (string) 
                      (symbol-from-string string)) 
                  (send dob :active-variables '(category))))
         (variables (combine numeric-variables category-variables))
         (types (send dob :active-types '(all)))
         (plot)
         (splot)
         (plots-list)
         (plots-lol )
         (nnv (length numeric-variables))
         (nv (length variables)))
    (dotimes (i nnv)
             (dotimes (j nv)
                      (unless (= j (1- nnv))
                              (cond
                                ((= i 0)
                                 (cond
                                   ((= j i)
                                    (setf plot 
                                          `(box-plot ,numeric-variables-list)))
                                   ((< j nnv) (setf plot nil))
                                   (t
                                    (setf plot `(grouped-box-plot 
                                                 (list ,(select variables j) 
                                                       ,(select variables i)))))))
                                (t
                                 (cond
                                    ((= i j) (setf plot nil))
                                    ((and (> j i) (< j nnv)) (setf plot nil)) ;i=1 j=2
                                   ((and (equal (select types j) "Numeric")     
                                         (equal (select types i) "Numeric"))
                                    (setf plot `(box-plot (list ,(select variables j) 
                                                                ,(select variables i)))))
                                   ((and (equal (select types j) "Numeric")     
                                         (equal (select types i) "Category"))
                                    (setf plot `(grouped-box-plot 
                                                 (list ,(select variables j) 
                                                       ,(select variables i)))))
                                   ((and (equal (select types j) "Category")     
                                         (equal (select types i) "Numeric"))
                                    (setf plot `(grouped-box-plot  
                                                 (list ,(select variables j)
                                                       ,(select variables i))))))
                                 ))
                              (setf plots-list (append plots-list (list plot)))
                              ))
             (setf plots-lol (append plots-lol (list plots-list)))
             (setf plots-list nil))
    (setf splot 
          (eval `(view ',plots-lol 
                 :style 1
                 :content-only t
                 :span-right ',(list (combine (1- nnv) 
                                             (repeat 0 (- nnv 2)) 
                                             (repeat 1 (- nv nnv)))
                                     (repeat (repeat 1 (1- nv)) (1- nnv))))))
    
    (send (send *current-spreadplot* :container) :title  (format nil "Bivariate View [~a]" (send @ :name)))
    ))


(defun numeric-bivariate-view (&optional (dob $))
  (let* ((variables (mapcar #'(lambda (string) 
                                (symbol-from-string string)) 
                      (send dob :active-variables '(numeric))))
         (types (send dob :active-types '(all)))
         (plot)
         (plots-list)
         (plots-lol) 
         (numvar (length variables))    
         (go t)
         )
    (cond
      ((> numvar 9) 
       (error-message "No more than 9 variables may be visualized.")
       (setf go nil))
      ((> numvar 7) 
       (setf go (two-button-dialog (format nil "There are ~d variables.~%Do you wish to visualize this many?" numvar) :first-button "Yes, Please" :second-button "No, Thanks"))))
    (when go
    (dotimes (i numvar)
             (dotimes (j (1+ numvar))
                      (cond
                        ((= j numvar)
                         (if (= i 0)
                             (setf plot `(labels-list))
                             (setf plot nil)))
                        ((= i j)
                         (setf plot `(cumulative-plot ,(select variables i))))
                        ((> i j)
                         (setf plot `(scatter-plot (list ,(select variables i) 
                                                         ,(select variables j)))))
                        ((< i j)
                         (setf plot `(comparison-plot (list ,(select variables i) 
                                                            ,(select variables j))))))
                      (setf plots-list (append plots-list (list plot))))
             (setf plots-lol (append plots-lol (list plots-list)))
             (setf plots-list nil))
    (eval `(view ',plots-lol :style 1 :content-only t
                 :span-down ',(list (combine (repeat 1 numvar) numvar)
                                    (repeat (combine (repeat 1 numvar) 0) (1- numvar)))
                 ))
    )))


(defun category-bivariate-view (&optional (dob $))
  (let* ((variables (mapcar #'(lambda (string) 
                                (symbol-from-string string)) 
                      (send dob :active-variables '(category))))
         (plot)
         (plots-list)
         (plots-lol) 
         (numvar (length variables))    
         (go t)
         )
    (cond
      ((> numvar 9) 
       (error-message "No more than 9 variables may be visualized.")
       (setf go nil))
      ((> numvar 7) 
       (setf go (two-button-dialog (format nil "There are ~d variables.~%Do you wish to visualize this many?" numvar) :first-button "Yes, Please" :second-button "No, Thanks"))))
    (when go
    (dotimes (i numvar)
             (dotimes (j numvar)
                      (cond
                        ((= i j)
                         (setf plot `(mosaic-plot ,(select variables i))))
                        (t
                         (setf plot `(mosaic-plot (list ,(select variables i) 
                                                        ,(select variables j))))))
                      (setf plots-list (append plots-list (list plot))))
             (setf plots-lol (append plots-lol (list plots-list)))
             (setf plots-list nil))
    (eval `(view ',plots-lol :style 1 :content-only t))
    )))




#|________________________________
 |
 | VIEW MENU ITEMS
 |________________________________
 |#

  (defun missing-view () (visualize-missing-data))
  (defun Numeric-view () (visualize-data :dialog nil :multivariate t))
  (defun Category-view  () (visualize-data :dialog nil :category t))
  (defun Frequency-view      () (visualize-data :dialog nil :frequency t))

  (defun Classified-view  () (visualize-data :dialog nil :classification t))
  (defun CrossTab-view  () (visualize-data :dialog nil :crosstabs t))

  (defun pairwise-view            () (bivariate-spreadplot))
  (defun scatterplot-view    () (scatter-spreadplot))
  (defun mosaic-view () (mosaic-spreadplot))

  (defun hhD-View () (visualize-data :dialog nil :guided-tour t))
  (defun make-a-new-view ()
    (load (strcat *default-path* "source\\sketch01")))


#|________________________________
 |
 | RELATIONAL VIEW
 |________________________________
 |#

(defun relational-view ()
  (cond
    ((equal (send $ :datatype) "matrix")
     (let* ((data (send $ :get-active-data-matrices))
            (nmat (send $ :nmat))
            (labels (send $ :active-variables '(numeric)))
            (data (sqrt (/ (apply #'+ (^ data 2)) nmat)))
            (type (four-button-dialog "These Relational Data are:" :first-button "Distances" :second-button "Correlations" :third-button "Covariances" :fourth-button "Cancel"))
            ;(mindata (min (combine data)))
            ;(maxdata (max (combine data)))
            (X (case type
                 (0 (mds-decomp data))
                 (1 (psd-decomp data))
                 (2 (psd-decomp data))
                 (t (top-level nil))))
            ;(X (mds-decomp data))
            (r (array-dimension X 1))
            (variables (mapcar #'(lambda (i) (format nil "Dim~a" i)) (iseq r)))
            (dob (data (send $ :title)
                       :data (combine X)
                       :variables variables
                       :labels labels
                       :iconify nil))
            )
       (send dob :visualize-data :multivariate t)
       ))
    (t (fatal-message "Data must be matrix data."))))


(defun mds-decomp (O &optional R)
"Args: O R
Computes Torgerson's Classical MDS of observed data in O, a symmetric (NxN) matrix of dissimilarities. Returns X, an (NxR) matrix of R-dimensional coordinates of points in Euclidean space, where R is the minimum of the specified value of R and the Rank of O. For the specific value of R, routine optimizes fit of XX' to B, where B is double-centered (^O 2)."
  (let* ((osq (^ o 2))
         (n (first (array-dimensions osq)))
         (means (mapcar #'mean (row-list osq)))
         (ones (repeat 1 n))
         (col-means (outer-product ones means))
         (B (* -.5 (+ (- osq col-means (transpose col-means)) (mean means))))
         (svd (sv-decomp B))
         (singvecs (first svd))
         (sqrt-singvals (sqrt (second svd)))
         (rank (length (which (> sqrt-singvals (mean sqrt-singvals)))))
         (R (if R (min rank R) rank))
         (L (diagonal (select sqrt-singvals (iseq r))))
         (U (select (first svd) (iseq n) (iseq r))))
    (matmult U L)))


(defun double-center (O)
  (let* ((osq (^ o 2))
         (n (first (array-dimensions osq)))
         (means (mapcar #'mean (row-list osq)))
         (ones (repeat 1 n))
         (col-means (outer-product ones means)))
    (* -.5 (+ (- osq col-means (transpose col-means)) (mean means)))))

(defun psd-decomp (O &optional R)
  (let* ((svd (sv-decomp O))
         (n (first (array-dimensions o)))
         (singvecs (first svd))
         (sqrt-singvals (sqrt (second svd)))
         (rank (length (which (> sqrt-singvals (mean sqrt-singvals)))))
         (R (if R (min rank R) rank))
         (L (diagonal (select sqrt-singvals (iseq r))))
         (U (select (first svd) (iseq n) (iseq r))))
    (matmult U L)))
